home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / examples / demo / demosrc / d_people.pro < prev    next >
Encoding:
Text File  |  1997-07-08  |  29.0 KB  |  978 lines
  1. ; $Id: d_people.pro,v 1.19 1997/04/25 23:04:18 tremblay Exp $
  2. ;
  3. ;  Copyright (c) 1997, Research Systems, Inc. All rights reserved.
  4. ;       Unauthorized reproduction prohibited.
  5. ;
  6. ;+
  7. ;  FILE:
  8. ;       d_people.pro
  9. ;
  10. ;  CALLING SEQUENCE: d_people
  11. ;
  12. ;  PURPOSE:
  13. ;       Shows the RSI GREAT!! family.
  14. ;       The user can then play with the warping and morphing
  15. ;       features.
  16. ;
  17. ;  MAJOR TOPICS: Data analysis and images
  18. ;
  19. ;  CATEGORY:
  20. ;       IDL 5.0
  21. ;
  22. ;  INTERNAL FUNCTIONS and PROCEDURES:
  23. ;       fun PeopleLuminance     - Set the images luminance
  24. ;       pro read_people_index   - Get the index of the image
  25. ;       fun People_image        - read the people image
  26. ;       pro load_morph          - Start up the morphing application
  27. ;       pro display_everyone    - Display the image of everyone
  28. ;       pro People_display      - Display the original image
  29. ;       pro PeopleCorners       - Set up corners points for warping
  30. ;       pro People_event        - Event handler
  31. ;       pro PeopleCleanup       - Cleanup
  32. ;       pro d_people            - Main procedure
  33. ;
  34. ;  EXTERNAL FUNCTIONS, PROCEDURES, and FILES:
  35. ;       pro d_morph             - Morphing application
  36. ;
  37. ;  REFERENCE: IDL Reference Guide, IDL User's Guide
  38. ;
  39. ;  NAMED STRUCTURES:
  40. ;       none.
  41. ;
  42. ;  COMMON BLOCS:
  43. ;       none.
  44. ;
  45. ;  MODIFICATION HISTORY:  Written by:  DS, RSI
  46. ;                         Modified by DS,RSI,  February 1997
  47. ;-
  48. ;--------------------------------------------------------------------
  49. ;
  50. ;  Purpose:  Convert an RBG (3,n,m) image to Black & White.
  51. ;
  52. function PeopleLuminance, $
  53.     Im, $      ; IN: image
  54.     Ct         ; IN: number of images
  55.  
  56.     ;   Two ways to do this.
  57.     ;
  58.     ; r = FIX(FINDGEN(256) * .3 + 0.5)
  59.     ; g = FIX(FINDGEN(256) * .59 + 0.5)
  60.     ; b = FIX(FINDGEN(256) * .11 + 0.5)
  61.     ; RETURN, BYTSCL(REFORM(r(im(0,*,*)) + g(im(1,*,*)) + b(im(2,*,*))))
  62.  
  63.     ;  If already quantized. Set luminance value to 0.3, o.59, 0.11
  64.     ;  for RGB respectively.
  65.     ;
  66.     if (N_ELEMENTS(ct) GT 1) then begin
  67.         rr = ROUND(ct(*,0) * .30)
  68.         gg = ROUND(ct(*,1) * .59)
  69.         bb = ROUND(ct(*,2) * .11)
  70.         RETURN, BYTSCL(rr(im) + gg(im) + bb(im))
  71.     endif else $
  72.         RETURN, REFORM(BYTSCL(.3 * im(0,*,*) + $
  73.             0.59 * im(1,*,*) + .11 * im(2,*,*), $
  74.             TOP=!D.N_COLORS-1 < 256))
  75. end
  76.  
  77. ;--------------------------------------------------------------------
  78. ;
  79. ;  Purpose: Read the people index file: people.idx.
  80. ;           Store the names and offsetsn the output parameters.
  81. ;
  82. pro read_people_index, $
  83.     names,  $               ; IN: string array containing the names.
  84.     offsets, $             ; IN: image ofset index.
  85.     USE_CURRENT=use_current ; IN: indicate to use the current data file.
  86.  
  87.     filename = 'people.idx'
  88.  
  89.     if (KEYWORD_SET(use_current) EQ 0) then $
  90.         ;filename = demopath(filename, SUBDIR=['examples','data'])
  91.         filename = filepath(filename, SUBDIR=['examples','data'])
  92.  
  93.     OPENR, lun, filename, /GET, ERROR=i
  94.  
  95.     if (i NE 0) then message,'people.idx file not found'
  96.  
  97.     np = 0L            ;The number of people
  98.     READF, lun, np
  99.     names = STRARR(np)
  100.     offsets = LONARR(np+2)
  101.     for i=0, np+1 do begin
  102.         a='' & off = 0L
  103.         READF, lun, off, a
  104.         a = STRTRIM(a,2)   ;Remove leading & trailing
  105.         offsets(i) = off
  106.         if (i LT np) then names(i) = a
  107.     endfor
  108.  
  109.     CLOSE, lun
  110.     FREE_LUN, lun
  111. end
  112.  
  113. ;--------------------------------------------------------------------
  114. ;
  115. ;  Purpose  Read an image from the file and returns it.
  116. ;
  117. function people_image, $
  118.     index, $            ; IN: image index.
  119.     lun, $              ; IN: file lun
  120.     offsets, $         ; IN: image offset parameters.
  121.     LABEL=lw, $         ; IN: (opt) Label or text widget to set to
  122.                         ; "Reading JPEG" while reading
  123.     REQUIRED_SIZE = reqs, $ ; IN: (opt) Set the image to this size.
  124.     BW = bw, $          ; IN: (opt) if set, always return a black/white image
  125.     QUANTIZE=quant
  126.  
  127.  
  128.     ;  Handle the JPEG option (LABEL keyword).
  129.     ;
  130.     if (KEYWORD_SET(lw)) then begin
  131.         WIDGET_CONTROL, lw, SET_VALUE='Decompressing JPEG image'
  132.     endif
  133.  
  134.     point_lun, lun, offsets(index)
  135.  
  136.     ;  Read the JPEG image returned as jpegImage.
  137.     ;
  138.     if (KEYWORD_SET(quant) AND (!D.N_COLORS LE 256)) then begin
  139.         read_jpeg, UNIT=lun, jpegImage, quant, COLORS=!D.N_COLORS-1, /TWO_PASS
  140.     endif else if (KEYWORD_SET(bw)) then begin
  141.         read_jpeg, unit = lun, jpegImage, /GRAYSCALE, COLORS=!D.TABLE_SIZE-1
  142.     endif else begin
  143.         read_jpeg, unit = lun, jpegImage
  144.     endelse
  145.  
  146.     ;  Resize the image if needed.
  147.     ;
  148.     s = size(jpegImage)
  149.     if (N_ELEMENTS(reqs) GT 0) then begin
  150.         if (KEYWORD_SET(lw)) then WIDGET_CONTROL, lw, SET_VALUE='Resampling'
  151.  
  152.         if (s(0) EQ 3 AND s(2) NE reqs) then begin
  153.             jpegImage = congrid(jpegImage, 3, reqs, reqs, /interp)
  154.         endif
  155.  
  156.         if (s(0) EQ 2 AND s(1) NE reqs) then begin
  157.             jpegImage = congrid(jpegImage, reqs, reqs)
  158.         endif
  159.     endif
  160.  
  161.     if (KEYWORD_SET(lw)) then WIDGET_CONTROL, lw, SET_VALUE=' '
  162.  
  163.     RETURN, jpegImage
  164. end
  165.  
  166. ;--------------------------------------------------------------------
  167. ;
  168. ;  Purpose Call the morphing routine.
  169. ;
  170. pro load_morph, $
  171.     index, $  ; IN: image index
  172.     top       ; IN: top base (parent) identifier
  173.  
  174.     ;  Construct the common variable bloc.
  175.     ;
  176.     common people_common, base, bases, window, draw, mode, names, np, $
  177.     button, txt_wid, ncpnts, cpnts, dcolor, image, imagew, imagewq, $
  178.     corners, x0, y0, x1, y1, siz, first, sx, $
  179.     morph_flag, lun, offsets, plist, quintic, bw_loaded, face_loaded, ct, $
  180.         wText, sText, $   ;  tips widgets and text structure
  181.         controlbuttonID, $
  182.     image_everyone, ct_everyone
  183.  
  184.     ;  Do morphing on the first image.
  185.     ;
  186.     if (morph_flag(0) EQ -1) then begin    ;First image
  187.     morph_flag = [index+1, 0]
  188.         textChange = ['secon', 'lmbut', 'void']
  189.         putTips, sText, wText[1], $
  190.             textChange, [0,1,2]
  191.  
  192.       
  193.     ;  Do morphing on the second image.
  194.     ;
  195.     endif else if morph_flag(1) EQ 0 then begin
  196.         textChange = ['selecto', 'mouse', 'show1']
  197.         putTips, sText, wText[1], $
  198.             textChange, [0,1,2]
  199.         d_morph, GROUP=top, /FROM_PEOPLE, $
  200.         people_image(morph_flag(0)-1, lun, offsets, $
  201.              REQ=256, /BW), $
  202.             people_image(index, lun, offsets,  REQ=256, /BW)
  203.     morph_flag = 0
  204.     endif        ;Morph_flag(1) EQ 0
  205. end
  206.  
  207. ;--------------------------------------------------------------------
  208. ;
  209. ;  Purpose  Display everyone images.
  210. ;
  211. pro display_everyone
  212.     common people_common
  213.  
  214.     if (N_ELEMENTS(ct_everyone) GT 1) then begin
  215.         TVLCT, ct_everyone
  216.         bw_loaded = 0
  217.     endif else begin
  218.         if (bw_loaded EQ 0) then LOADCT, 0, /silent
  219.         bw_loaded = 1
  220.     endelse
  221.  
  222.     if (size(image_everyone))(0) EQ 3 then tv, image_everyone, TRUE=1 $
  223.     else tv, image_everyone
  224. end
  225.     
  226. ;--------------------------------------------------------------------
  227. ;
  228. ;  Purpose  Display the original image.
  229. ;
  230. pro people_display, $
  231.     Nmode, $  ; IN: = 1 to display original image with CP's
  232.               ;     = 2 or warped image if available
  233.               ;     = 3 for quintic warped
  234.     ctable    ; IN: color table
  235.  
  236.     common people_common
  237.  
  238.     ;  Display  a color image.
  239.     ;
  240.     if (Nmode EQ 0) then begin
  241.         s = size(image)
  242.         image_true = s(0) EQ 3
  243.         display_true = !D.N_COLORS GT 256
  244.  
  245.         if (N_ELEMENTS(ctable) GT 1) then begin
  246.             TVLCT, ctable
  247.             bw_loaded = 0
  248.         endif else if (image_true EQ display_true) or (image_true EQ 0) then begin
  249.             if bw_loaded EQ 0 then LOADCT,0, /SILENT ;Load bw
  250.             bw_loaded = 1
  251.         endif
  252.  
  253.         if (image_true AND display_true) then TV, image, TRUE=1 $
  254.         else if (image_true EQ 0) then TV, image $
  255.         else if (image_true) then begin   ;Load true color on indexed display
  256.             tmp =  color_quan(image, 1, rr, gg, bb)
  257.             erase
  258.             TVLCT, rr, gg, bb
  259.             TV, temporary(tmp)
  260.             bw_loaded = 0
  261.         endif
  262.         RETURN
  263.     endif
  264.  
  265.     ;  If we get here, we're displaying in monochrome.
  266.     ;
  267.     if (bw_loaded EQ 0) then LOADCT, 0, /SILENT ;Load bw table?
  268.     bw_loaded = 1
  269.  
  270.     if (Nmode EQ mode) then RETURN
  271.     mode = Nmode
  272.     if (mode EQ 1) then begin
  273.         TV, image
  274.         DEVICE, SET_GRAPHICS=6        ; XOR
  275.         for i=0, ncpnts-1 do $      ; Redraw arrows
  276.             ARROW, cpnts(0,i), cpnts(1,i), cpnts(2,i), cpnts(3,i), $
  277.             COLOR=dcolor
  278.         DEVICE, SET_GRAPHICS=3        ; XOR
  279.     endif else if ((mode EQ 2) AND (N_ELEMENTS(imagew) GT 2)) then $
  280.         TV, imagew $
  281.     else if ( (mode EQ 3) AND (N_ELEMENTS(imagewq) GT 2)) then $
  282.         TV, imagewq
  283.  
  284. end
  285.  
  286. ;--------------------------------------------------------------------
  287. ;
  288. ;  Purpose  Add corners if necessary. Returns the number
  289. ;           of corner points (n).
  290. ;
  291. pro PeopleCorners, $
  292.     n     ;  OUT: number of corners.
  293.  
  294.     common people_common
  295.  
  296.     if ((corners) AND (ncpnts LT 96) ) then begin
  297.         ix = (!d.x_size-1) * [0,1,1,0]
  298.         iy = (!d.y_size-1) * [0,0,1,1]
  299.         for i = 0, 3 do cpnts(0, i+ncpnts) = [ix(i), iy(i), ix(i), iy(i)]
  300.         n = ncpnts + 3
  301.     endif else n = ncpnts-1
  302. end
  303.  
  304. ;--------------------------------------------------------------------
  305. ;
  306. ;  Purpose  Main event handler.
  307. ;
  308. pro People_Events, $
  309.     sEvent    ; IN: event structure
  310.  
  311.     common people_common
  312.  
  313.     ;  Quit the application using the close box.
  314.     ;
  315.     if (TAG_NAMES(sEvent, /STRUCTURE_NAME) EQ $
  316.         'WIDGET_KILL_REQUEST') then begin
  317.         WIDGET_CONTROL, sEvent.top, /DESTROY
  318.         RETURN
  319.     endif
  320.  
  321.     WSET, window
  322.  
  323.     ;  Handle a mouse button or motion event.
  324.     ;
  325.     if (sEvent.id EQ draw) then begin  
  326.  
  327.         ;  Handle the click on person's face.
  328.         ;
  329.         if (mode EQ 0) then begin
  330.             if ((first EQ 0) OR (sEvent.press EQ 0)) then RETURN
  331.             i = (sEvent.x / sx) + (siz/sx) * ((siz-sEvent.y) / sx)
  332.  
  333.             ;  Returns if not legitimate.
  334.             ;
  335.             if (i GE np) then RETURN   
  336.             first = 1
  337.  
  338.             ;  Sensitize the warping button, desensitize the
  339.             ;  morphing button.
  340.             ;
  341.             morphsz = size(morph_flag)
  342.             if (morphsz(0) EQ 0) then begin
  343.                 if (morph_flag NE -1) then begin
  344.                     WIDGET_CONTROL, controlButtonID(0), SENSITIVE=1
  345.                     WIDGET_CONTROL, controlButtonID(1), SENSITIVE=0
  346.                 endif
  347.             endif else if (morphsz(0) EQ 1) then begin
  348.                 if (morph_flag(1) NE 0) then begin
  349.                     WIDGET_CONTROL, controlButtonID(0), SENSITIVE=1
  350.                     WIDGET_CONTROL, controlButtonID(1), SENSITIVE=0
  351.                 endif
  352.             endif
  353.  
  354.             goto, load_face
  355.  
  356.         endif
  357.  
  358.         dcolor = 255
  359.  
  360.         ;  Handle button press.
  361.         ;
  362.         if ((sEvent.press AND 1) NE 0) then begin
  363.  
  364.             if (button EQ 1) then RETURN
  365.             people_display, 1
  366.             DEVICE, SET_GRAPHICS=6  ; Use XOR drawing mode
  367.  
  368.             x1 = (x0 = sEvent.x)          ; Get 1st point
  369.             y1 = (y0 = sEvent.y)
  370.             button = 1
  371.             PLOTS, [x0, x1],[y0, y1], COLOR=dcolor, /DEVICE ;new spot
  372.  
  373.             RETURN
  374.         endif
  375.  
  376.         ;  Handle button release.
  377.         ;
  378.         if ((sEvent.release and 1) NE 0) then begin
  379.             imagew = 0 & imagewq = 0
  380.             PLOTS, [x0, x1],[y0, y1], COLOR=dcolor, /DEVICE ;Erase old
  381.             arrow, x0, y0, x1, y1, COLOR=dcolor
  382.             DEVICE, SET_GRAPHICS=3  ; Restore graphics mode
  383.             button = 0
  384.  
  385.             if (ncpnts GE 99) then begin
  386.                 too_many: $
  387.                     textChange = ['tooma']
  388.                     putTips, sText, wText[1], $
  389.                         textChange, [2]
  390.  
  391.                  RETURN
  392.             endif
  393.             cpnts(0:3, ncpnts) = [ x0, y0, x1, y1] ; Save it
  394.             ncpnts = ncpnts + 1 ; One more
  395.             RETURN
  396.         endif
  397.  
  398.         ;  Handle button motion.
  399.         ;
  400.         if (button) then begin
  401.             PLOTS, [x0, x1],[y0, y1], COLOR=dcolor, /DEVICE ;Erase old
  402.             x1 = sEvent.x > 0 < (!d.x_size-1) ;In range
  403.             y1 = sEvent.y > 0 < (!d.y_size-1)
  404.             PLOTS, [x0, x1],[y0, y1], COLOR=dcolor, /DEVICE ;Draw new
  405.             RETURN
  406.         endif                       ;Motion
  407.  
  408.         RETURN            ;Ignore plain motion events
  409.  
  410.     endif   ;  of  sEvent.id EQ draw
  411.  
  412.  
  413.     WIDGET_CONTROL, sEvent.top, /HOURGLASS
  414.  
  415.     ;  Handle the event of a pressed button.
  416.     ;  (People button).
  417.     ;
  418.     if (sEvent.id EQ plist) then begin
  419.         i = sEvent.index
  420.         if (mode NE 0) then begin
  421.             Load_person:    mode = 0 & morph_flag = 0
  422.             WIDGET_CONTROL, bases(1), MAP=0
  423.             WIDGET_CONTROL, bases(0), MAP=1
  424.             imagew = 0 & imagewq = 0
  425.             ncpnts = 0
  426.  
  427.             ;  Desensitize the warping button, sensitize the
  428.             ;  morphing button.
  429.             ;
  430.             WIDGET_CONTROL, controlButtonID(0), SENSITIVE=0
  431.             WIDGET_CONTROL, controlButtonID(1), SENSITIVE=1
  432.         endif
  433.  
  434.         ;  Handle the press of the 'everyone' button.
  435.         ;
  436.         if (i EQ (np-1)) then begin  
  437.             text = names(i)
  438.             show_everyone:
  439.             erase
  440.             mode = 0
  441.             first = 1
  442.             face_loaded = -1
  443.             display_everyone
  444.             image = 0
  445.  
  446.             ;  Desensitize the warping button, sensitize the
  447.             ;  morphing button.
  448.             ;
  449.             WIDGET_CONTROL, controlButtonID(0), SENSITIVE=0
  450.             WIDGET_CONTROL, controlButtonID(1), SENSITIVE=1
  451.  
  452.             RETURN
  453.         endif
  454.  
  455.         ;  Display a new person.
  456.         ;
  457.         LOAD_FACE:
  458.         WIDGET_CONTROL, sEvent.top, /HOURGLASS
  459.         if (morph_flag(0) NE 0) then begin
  460.             load_morph, i(0), sEvent.top
  461.             RETURN
  462.         endif
  463.  
  464.         ;  Here, the event was bgenerated by selecting the 
  465.         ;  person from the widget list.
  466.         ;
  467.         first = 0     
  468.         face_loaded = i(0)
  469.         WIDGET_CONTROL, plist, SET_LIST_SELECT=face_loaded
  470.         ct = 1
  471.         image = people_image(face_loaded, lun, $
  472.             offsets, REQ=siz, QUANTIZE=ct)
  473.  
  474.         WSET, window
  475.         people_display, 0, ct
  476.         image = 0 & imagewq = 0 & imagew = 0 ;No more warped
  477.         stext.text[9] = names(i)
  478.         textChange = ['void','void','names']
  479.         putTips, sText, wText[1], $
  480.             textChange, [0,1,2]
  481.  
  482.         ;  Sensitize the warping button, desensitize the
  483.         ;  morphing button.
  484.         ;
  485.         WIDGET_CONTROL, controlButtonID(0), SENSITIVE=1
  486.         WIDGET_CONTROL, controlButtonID(1), SENSITIVE=0
  487.  
  488.         RETURN
  489.     endif                           ;People button
  490.  
  491.  
  492.     WIDGET_CONTROL, sEvent.id, GET_UVALUE=b
  493.  
  494.     ;  Handle the event from a compound widget button group.
  495.     ;
  496.     if (b EQ 'CW') then b = sEvent.value  ;A cw_bgroup button
  497.  
  498.     button = 0        ;Mouse buttons are up now
  499.  
  500.     ;  Branch to the corresponding widget button event.
  501.     ;
  502.     case b of            ;It must be a widget button event
  503.  
  504.         ;  Everyone button.
  505.         ;
  506.         'Everyone' : begin
  507.             load_everyone: i = np - 1
  508.             textChange = ['selecto','mouse','show1']
  509.             putTips, sText, wText[1], $
  510.                 textChange, [0,1,2]
  511.             goto, Load_person
  512.  
  513.             ;  Desensitize the warping button, sensitize the
  514.             ;  morphing button.
  515.             ;
  516.             WIDGET_CONTROL, controlButtonID(0), SENSITIVE=0
  517.             WIDGET_CONTROL, controlButtonID(1), SENSITIVE=1
  518.  
  519.         endcase
  520.  
  521.         ;  Launch the color table tool.
  522.         ;
  523.         'Colors':  begin
  524.             xLOADCT, GROUP=sEvent.top
  525.             bw_loaded = 0
  526.         endcase
  527.  
  528.         ;  Quit the application.
  529.         ;
  530.         'Quit': begin  
  531.             image = 0 & imagew = 0 & imagewq = 0
  532.             WIDGET_CONTROL, base, /DESTROY
  533.             FREE_LUN, lun
  534.         endcase
  535.  
  536.         ;  Display the information (help) file.
  537.         ;
  538.         "Help" : begin
  539.  
  540.             if ( XREGISTERED('XDisplayFile') NE 0) then RETURN
  541.             XDisplayFile, filepath("people_demo.txt", $
  542.                 SUBDIR=['examples', 'demo', 'demotext']), $
  543.                 DONE_BUTTON='Done', $
  544.                 TITLE="People demo help", $
  545.                 GROUP=sEvent.top, $
  546.                 WIDTH=55, HEIGHT=14
  547.             RETURN
  548.         endcase
  549.  
  550.         ;  Load the warping options (new menu).
  551.         ;
  552.         'Warping': begin
  553.             if (mode NE 0) or face_loaded LT 0 then return
  554.             image =  people_image(face_loaded, lun, offsets, $
  555.                           REQ=siz, /BW)
  556.             mode = 1             ;Set warping mode
  557.             WIDGET_CONTROL, bases(0), MAP=0
  558.             WIDGET_CONTROL, bases(1), MAP=1
  559.             textChange = ['void','mark3', 'lmbut']
  560.             putTips, sText, wText[1], $
  561.                 textChange, [0,1,2]
  562.  
  563.             if (bw_loaded EQ 0) then begin
  564.                 LOADCT,0,/silent
  565.                 TV, image
  566.                 bw_loaded = 1
  567.             endif
  568.         endcase
  569.  
  570.         ;  Load the morphing menu.
  571.         ;
  572.         "Morphing": begin
  573.             morph_flag = -1
  574.             WIDGET_CONTROL, bases(1), MAP=0
  575.             WIDGET_CONTROL, bases(0), MAP=1
  576.             textChange = ['sele2','lmbut','void']
  577.             putTips, sText, wText[1], $
  578.                 textChange, [0,1,2]
  579.             text = 'Select two people'
  580.             goto, show_everyone
  581.  
  582.         endcase
  583.  
  584.         
  585.         ;  Launch the color table tool.
  586.         ;
  587.         "COLORS": begin
  588.             xLOADCT, GROUP=sEvent.top
  589.             bw_loaded = 0
  590.         endcase
  591.  
  592.         ; "Done Warping": goto, back_to_people
  593.         ;
  594.         "Everyone": begin
  595.  
  596.             ;  Desensitize the warping button, sensitize the
  597.             ;  morphing button.
  598.             ;
  599.             WIDGET_CONTROL, controlButtonID(0), SENSITIVE=0
  600.             WIDGET_CONTROL, controlButtonID(1), SENSITIVE=1
  601.             goto, load_everyone
  602.         endcase
  603.  
  604.         ; ..........  Handle the warping panel..........
  605.  
  606.         ; Remove most recent tie point.
  607.         ;
  608.         "Undo": begin
  609.             people_display, 1
  610.             imagew = 0 & imagewq = 0
  611.             if (ncpnts EQ 0) then return ;Anything?
  612.             i = (ncpnts = ncpnts-1)
  613.             DEVICE, SET_GRAPHICS=6    ;Redraw last CP to erase
  614.             arrow, cpnts(0,i), cpnts(1,i), cpnts(2,i), cpnts(3,i), $
  615.                 color=dcolor
  616.             DEVICE, SET_GRAPHICS=3
  617.         endcase
  618.  
  619.         ;  Set the corner options.
  620.         ;
  621.         "On":   corners = 1
  622.         "Off":  corners = 0
  623.  
  624.         ;  Reset (display) the unwarped image.
  625.         ;
  626.         "Reset": begin
  627.             imagew = 0 & imagewq = 0
  628.             ncpnts = 0
  629.             mode = 1
  630.             TV, image
  631.         endcase
  632.  
  633.         ;  Display the original image.
  634.         ;
  635.         "Original": begin
  636.             people_display, 1
  637.         endcase
  638.  
  639.         ;  Plot the warping surface function.
  640.         ;
  641.         "Surface": begin
  642.             if (ncpnts + (corners*2) LT 3) then RETURN
  643.             !P.MULTI=[0,1,2]        ;Double up
  644.             PeopleCorners, n
  645.  
  646.             for i=0,1 do begin      ;X and Y
  647.                 z = cpnts(i+2,*)
  648.  
  649.                 if (i EQ 1) then $
  650.                     p0 = REPLICATE(1,51) # (FINDGEN(51) * (siz/50.)) $
  651.                 else p0 = (FINDGEN(51) * (siz/50.)) # replicate(1,51)
  652.  
  653.                 TRIANGULATE, cpnts(0,0:n), cpnts(1, 0:n), tr
  654.                 p = TRIGRID(cpnts(0,0:n), cpnts(1, 0:n),z(0:n), tr, $
  655.                     QUINT= N_ELEMENTS(imagewq) GT 2)
  656.                 SURFACE, p - p0, TITLE=(['X','Y'])(i) + ' Deformation'
  657.             endfor
  658.  
  659.             !P.MULTI=0
  660.             mode = 5
  661.         endcase
  662.  
  663.         ;  Set the warping function to linear.
  664.         ;
  665.         "Warp Linear": begin
  666.             quintic = 0
  667.             goto, do_warp
  668.         endcase
  669.  
  670.         ;  Set the warping function to linear.
  671.         ;
  672.         "Warp Smooth":  begin
  673.             quintic = 1
  674.             do_warp: if ncpnts  + (corners*2) LT 3 then return
  675.             PeopleCorners, n
  676.  
  677.             if quintic and KEYWORD_SET(imagewq) EQ 0 then $
  678.               imagewq = WARP_TRI(cpnts(2,0:n), cpnts(3,0:n), $
  679.                   cpnts(0,0:n), cpnts(1,0:n), image, /QUINT)
  680.             if (quintic EQ 0) and (KEYWORD_SET(imagew) EQ 0) then $
  681.               imagew = WARP_TRI(cpnts(2,0:n), cpnts(3,0:n), $
  682.                   cpnts(0,0:n), cpnts(1,0:n), image)
  683.  
  684.             people_display, 2+quintic ;Show warped image
  685.         endcase
  686.  
  687.         ;  Animate the warping sequence.
  688.         ;
  689.         "Animate":  begin
  690.             if (ncpnts + (corners*2)  LT 3) then return
  691.             PeopleCorners, n
  692.             nframes = 12
  693.             xinteranimate, SET=[siz, siz, nframes], /SHOWLOAD, /CYCLE
  694.             TV, image               ;First frame = original
  695.             xinteranimate, window=!d.window, frame=0
  696.             cpx = cpnts(0,0:n)  & cpy = cpnts(1,0:n)
  697.             for i=1, nframes-1 do begin
  698.                 t = i / (nframes-1.)
  699.                 x = (cpnts(2,0:n) - cpx) * t + cpx
  700.                 y = (cpnts(3,0:n) - cpy) * t + cpy
  701.                 TV, WARP_TRI(x,y, cpx, cpy, image, QUINT=quintic)
  702.                 xinteranimate, window=!d.window, frame=i
  703.             endfor
  704.             xinteranimate, 20, GROUP=sEvent.top
  705.         endcase
  706.  
  707.         else:  help, /structure, sEvent ;Dunno...
  708.     endcase                         ;String value
  709.     RETURN
  710. end
  711.  
  712. ;--------------------------------------------------------------------
  713. ;
  714. ;  Purpose  Cleanup procedure.
  715. ;
  716. Pro PeopleCleanup, $
  717.     wTopBase    ;  IN: identifier
  718.  
  719.     ;  Get the color table saved in the window's user value.
  720.     ;
  721.     WIDGET_CONTROL, wTopBase, GET_UVALUE=sState,/No_Copy
  722.   
  723.     ;  Restore the previous color table.
  724.     ;
  725.     TVLCT, sState.previouscolorTable
  726.  
  727.     common people_common
  728.  
  729.     image = 0 & imagew = 0 & imagewq = 0
  730.     image_everyone = 0 & ct_everyone = 0
  731.  
  732.     ;  Map the group leader base if it exists.
  733.     ;
  734.     if (WIDGET_INFO(sState.groupBase, /VALID_ID)) then $
  735.         WIDGET_CONTROL, sState.groupBase, /MAP
  736.  
  737. end
  738.  
  739. ;--------------------------------------------------------------------
  740. ;
  741. ;  Purpose  Main people procedure. This application shows
  742. ;           The images (digital photography) of RSI employees.
  743. ;           Moreover, the user can use the morphing and
  744. ;           the warping tools.
  745. ;
  746. pro d_people, $
  747.     USE_CURRENT=use_current, $; IN: (opt) use file in current directory.
  748.     GROUP=group, $            ; IN: (opt) group identifier
  749.     APPTLB = appTlb           ; OUT: (opt) TLB of this application
  750.  
  751.     common people_common
  752.  
  753.     if n_elements(group) eq 0 then group = 0L
  754.  
  755.     ;   Have one instance of the application running.
  756.     ;
  757.     if (xregistered("people")) then RETURN
  758.  
  759.     ;  Get the current color table. It will be restored when exiting.
  760.     ;
  761.     TVLCT, savedR, savedG, savedB, /GET
  762.     previousColorTable = [[savedR],[savedG],[savedB]]
  763.  
  764.     drawbase = startmes(GROUP=group)    ;  Create the starting up message.
  765.  
  766.     ;  Initialize working variable and arrays.
  767.     ;
  768.     mode = 0                        ; Not warp mode
  769.     button = 0                ; Button status
  770.     ncpnts = 0                ; # of control pnts
  771.     morph_flag = 0
  772.     cpnts = fltarr(4,100)        ; Control point array
  773.     dcolor = 'aa'x            ; XOR Drawing color
  774.     DEVICE, GET_SCREEN_SIZE=x
  775.  
  776.     if (x(0) LT 800) then begin
  777.         result = $
  778.         WIDGET_MESSAGE('This application is optimized for 800 x 640 resolution.')
  779.     endif
  780.  
  781.     if (x(0) LE 640) then siz=384 else siz = 512
  782.     siz = 512            ;Drawable size
  783.     quintic = 0
  784.     first = 1
  785.     bw_loaded = 1
  786.     face_loaded = -1
  787.     corners = 1
  788.  
  789.     ;  Read the data file that contain the image of every employees.
  790.     ;
  791.     read_people_index, names, offsets, USE_CURRENT=use_current
  792.     filename = 'people.jpg'
  793.  
  794.     if (KEYWORD_SET(use_current) EQ 0) then  $
  795.         filename = filepath(filename, SUBDIR=['examples','data'])
  796.  
  797.     OPENR, lun, filename, /STREAM, /GET ;For VMS...
  798.  
  799.     names = [names, 'Everyone']    ;Add last image
  800.     np = N_ELEMENTS(names)
  801.  
  802.     nx = CEIL(SQRT(np-1))        ;# of images across
  803.     sx = siz / nx            ;Size of image
  804.  
  805.     ;  Set the text font accrding to the hardware platform.
  806.     ;
  807.     version = WIDGET_INFO(/version)
  808.     if (STRPOS(version.style, 'Windows') NE -1) then begin
  809.         helb24 = 'arial*bold*24'    ;Fonts we might find on DOS
  810.         helb18 = 'arial*bold*18'
  811.         helb14 = 'arial*bold*14'
  812.         hel14 =  'arial*14'
  813.     endif else begin
  814.         helb24 = '*helvetica-bold-r*240*' ;Fonts we use
  815.         helb18 = '*helvetica-bold-r*180*'
  816.         helb14 = '*helvetica-bold-r*140*'
  817.         hel14 =  '*helvetica-medium-r*140*'
  818.     endelse
  819.  
  820.     ;  Get the tips.
  821.     ;
  822.     sText = getTips(filepath('people.tip', $
  823.         SUBDIR=['examples','demo', 'demotext']) )
  824.  
  825.  
  826.     myScroll = x(0) LT 750      ;  Determine if the scroll bar is needed.
  827.  
  828.     ;  Create the widgets starting with the top level base.
  829.     ;
  830.     if myScroll then begin
  831.         base = WIDGET_BASE(TITLE='The People of RSI', $
  832.                            /TLB_KILL_REQUEST_EVENTS, $
  833.                            MAP=0, $
  834.                            SCROLL=myScroll, $
  835.                            X_SCROLL_SIZE=x(0)-75, Y_SCROLL_SIZE=x(1)-75, $
  836.                            MBAR=barBase, $
  837.                            GROUP_LEADER=group, /COLUMN)
  838.     endif else begin
  839.         base = WIDGET_BASE(TITLE='The People of RSI', $
  840.                            /TLB_KILL_REQUEST_EVENTS, $
  841.                            MAP=0, $
  842.                            MBAR=barBase, $
  843.                 GROUP_LEADER=group, /COLUMN)
  844.     endelse
  845.  
  846.         wFileButton = WIDGET_BUTTON(barBase, VALUE='File', $
  847.             UVALUE='File', /MENU)
  848.  
  849.             wQuitButton = WIDGET_BUTTON(wFileButton, VALUE='Quit', $
  850.                 UVALUE='Quit')
  851.  
  852.         wHelpButton = WIDGET_BUTTON(barBase, VALUE='About', $
  853.             UVALUE='HELP', /MENU, /HELP)
  854.  
  855.             wAboutButton = WIDGET_BUTTON(wHelpButton, $
  856.                 VALUE='About People of RSI', $
  857.                 UVALUE='Help')
  858.  
  859.  
  860.         ;  Create a sub base.
  861.         ;  
  862.         wSubTopBase = WIDGET_BASE(base, /ROW)
  863.  
  864.         ;  Create the left side controls.
  865.         ;
  866.         left = WIDGET_BASE(wSubTopBase, /BASE_ALIGN_CENTER, /COLUMN)
  867.  
  868.         wLeftSub0Base = WIDGET_BASE(left, /COLUMN)
  869.  
  870.             ctl_buttons = CW_BGROUP(wLeftSub0Base, COLUMN=1, $
  871.                  /FRAME, /NO_REL, /RETURN_NAME, $
  872.                  IDS=controlButtonID, $
  873.                  UVALUE='CW', $
  874.                  ['Warping', 'Morphing', 'Everyone'])
  875.  
  876.             wLeftSubBase = WIDGET_BASE(left )
  877.  
  878.                 bases = LONARR(2)
  879.                 for i=0,1 do bases(i) = WIDGET_BASE(wLeftSubBase, $
  880.                     /COLUMN)
  881.  
  882.                     plist = WIDGET_LIST(bases(0), $
  883.                         VALUE=names, YSIZE=15)
  884.  
  885.                     ;  Create the control panel for warping.
  886.                     ;
  887.                     wWarp1BGroup = CW_BGROUP(bases(1),  $
  888.                         /ROW, /NO_REL, /RETURN_NAME, $
  889.                         UVALUE='CW', ['Undo', 'Reset'])
  890.  
  891.                     wWarp2BGroup = CW_BGROUP(bases(1), $
  892.                         LABEL_TOP='View:', /FRAME, /RETURN_NAME, $
  893.                         UVALUE='CW', COLUMN=2, $
  894.                         ['Warp Linear', 'Warp Smooth', $
  895.                         'Animate', 'Original', $
  896.                         'Surface', 'Reset'])
  897.  
  898.                     wWarp3BGroup = CW_BGROUP(bases(1), $
  899.                         ['Off','On'], LABEL_TOP = 'Mark Corners', $
  900.                         UVALUE='CW', /ROW, /RETURN_NAME, $
  901.                         /NO_REL, /EXCLUSIVE, $
  902.                         SET_VALUE=corners)
  903.  
  904.         ;  Create the drawable in the center.
  905.         ;
  906.         center = WIDGET_BASE(wSubTopBase, /COLUMN)
  907.  
  908.             ;  Create a sub base in the center, and frame it.
  909.             ;
  910.             wCenterSubBase = WIDGET_BASE(center, /FRAME)
  911.  
  912.                 draw = widget_draw(wCenterSubBase, $
  913.                     XSIZE=siz, YSIZE=siz, RETAIN=2, $
  914.                     /BUTTON_EVENTS, /MOTION_EVENTS, COLORS=-5)
  915.  
  916.         ;  Create the status line label.
  917.         ;
  918.         wStatusBase = WIDGET_BASE(base, MAP=0, /ROW)
  919.  
  920.             nWidgets = 2
  921.             wText = LONARR(nWidgets)
  922.             widTips, wStatusBase, sText.text, XSIZE=36, $
  923.                 YSIZE=3, NWIDGETS=nWidgets, wText
  924.  
  925.     ;  Realize the widget hierarchy.
  926.     ;
  927.     WIDGET_CONTROL, /REALIZE, base
  928.  
  929.     appTLB = base
  930.  
  931.     WIDGET_CONTROL, bases(1), MAP=0
  932.     WIDGET_CONTROL, draw, GET_VALUE = window
  933.  
  934.     ERASE
  935.  
  936.     ;  Size the tips widgets.
  937.     ;
  938.     sizeTips, Base, wText, wStatusBase
  939.  
  940.     ;  Load the grey scale color table.
  941.     ;
  942.     LOADCT, 0, /SILENT
  943.  
  944.     ;  Display the image that contains all the employees.
  945.     ;
  946.     ct_everyone = 1
  947.     image_everyone = people_image(np-1, lun, offsets, $
  948.         REQUIRED_SIZE=siz, QUANTIZE=ct_everyone)
  949.     display_everyone
  950.  
  951.     ;  Create the state structure and make it the user value
  952.     ;  of the top level base.
  953.     ;
  954.     sState = { $
  955.         previousColorTable: previousColorTable, $
  956.         groupBase: group $      ; Base of Group Leader
  957.     }
  958.     WIDGET_CONTROL, base, SET_UVALUE=sState, /NO_COPY
  959.  
  960.     ;  Desensitize the warping button.
  961.     ;
  962.     WIDGET_CONTROL, controlButtonID(0), SENSITIVE=0
  963.  
  964.     ;  Destroy the starting up window.
  965.     ;
  966.     WIDGET_CONTROL, drawbase, /DESTROY
  967.  
  968.     ;  Map the top level base.
  969.     ;
  970.     WIDGET_CONTROL, base, MAP=1
  971.  
  972.  
  973.     ;  Register with xmamager.
  974.     ;
  975.     XManager, "d_people", base, EVENT_HANDLER = 'people_events', $
  976.     CLEANUP='peopleCleanup', /NO_BLOCK
  977. end
  978.